home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMPNENT / SAWIN95 / SYSHOT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-24  |  7KB  |  249 lines
  1. unit SysHot;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   WComp;
  8.  
  9. type
  10.   TWMHotKey = record
  11.     Msg: Cardinal;
  12.     idHotKey: Word;
  13.     Modifiers: Integer;
  14.     VirtKey : Integer;
  15.   end;
  16.  
  17.   THKModifier = (hkShift, hkCtrl, hkAlt, hkExt);
  18.   THKModifiers = set of THKModifier;
  19.  
  20.   TVirtKey =  (vkCancel, vkBack, vkTab, vkClear, vkReturn, vkPause, vkCapital, vkEscape,
  21.                vkSpace, vkPrior, vkNext, vkEnd, vkHome, vkLeft, vkUp, vkRight, vkDown,
  22.                vkSelect, vkExecute, vkSnapshot, vkInsert, vkDelete, vkHelp,
  23.                vk0, vk1, vk2, vk3, vk4, vk5, vk6, vk7, vk8, vk9,
  24.                vkA, vkB, vkC, vkD, vkE, vkF, vkG, vkH, vkI, vkJ, vkK, vkL, vkM,
  25.                vkN, vkO, vkP, vkQ, vkR, vkS, vkT, vkU, vkV, vkW, vkX, vkY, vkZ,
  26.                vkNumpad0, vkNumpad1, vkNumpad2, vkNumpad3, vkNumpad4,
  27.                vkNumpad5, vkNumpad6, vkNumpad7, vkNumpad8, vkNumpad9,
  28.                vkMultiply, vkAdd, vkSeparator, vkSubtract, vkDecimal, vkDivide,
  29.                vkF1, vkF2, vkF3, vkF4, vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12,
  30.                vkF13, vkF14, vkF15, vkF16, vkF17, vkF18, vkF19, vkF20, vkF21, vkF22, vkF23, vkF24,
  31.                vkNumlock, vkScroll);
  32.  
  33.   PHotKeyItem = ^THotKeyItem;
  34.   THotKeyItem = record
  35.     Modifiers : THKModifiers;
  36.     VirtKey   : TVirtKey;
  37.     Registered: Boolean;
  38.   end;
  39.  
  40.   THotKeyEvent = procedure(Sender: TObject; Index: Integer) of object;
  41.  
  42.   TSysHotKey = class(TWindowedComponent)
  43.   private
  44.     { property variables }
  45.     FActive  : Boolean;
  46.     { event variables }
  47.     FOnHotKey: THotKeyEvent;
  48.     { private variables }
  49.     FList    : TList;
  50.     { property setting/getting routines }
  51.     procedure SetActive(Value : Boolean);
  52.     function  GetCount: Integer;
  53.   protected
  54.     { method overrides }
  55.     procedure Loaded; override;
  56.     { message handlers }
  57.     procedure wmHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
  58.     procedure wmDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  59.     { private routines }
  60.     function  ModifiersToFlag(Modifiers : THKModifiers): UInt;
  61.     procedure RegisterHotKeyNr(Index : Integer);
  62.     procedure UnregisterHotKeyNr(Index : Integer);
  63.     procedure RegisterHotKeys;
  64.     procedure UnregisterHotKeys;
  65.   public
  66.     { constructor / destructor overrides }
  67.     constructor Create(AOwner: TComponent); override;
  68.     destructor Destroy; override;
  69.     { methods }
  70.     function  Add(Item: THotKeyItem): integer;
  71.     function  AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): integer;
  72.     procedure Clear;
  73.     procedure Delete(Index : Integer);
  74.     function  Get(Index: Integer): THotKeyItem;
  75.     procedure Put(Index: Integer; Item: THotKeyItem);
  76.     { runtime only properties }
  77.     property HotKeys[Index: Integer]: THotKeyItem read Get write Put; default;
  78.     property HotKeyCount: integer read GetCount;
  79.   published
  80.     { properties }
  81.     property Active: Boolean read FActive write SetActive;
  82.     { events }
  83.     property OnHotKey: THotKeyEvent read FOnHotKey write FOnHotKey;
  84.   end;
  85.  
  86. function MkHotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  87.  
  88. var
  89.   VirtKeys : array[TVirtKey] of UInt =
  90.              ($03, $08, $09, $0C, $0D, $13, $14, $1B,
  91.               $20, $21, $22, $23, $24, $25, $26, $27, $28,
  92.               $29, $2B, $2C, $2D, $2E, $2F,
  93.               $30, $31, $32, $33, $34, $35, $36, $37, $38, $39,
  94.               $41, $42, $43, $44, $45, $46, $47, $48, $49, $4A,
  95.               $4B, $4C, $4D, $4E, $4F, $50, $51, $52, $53, $54,
  96.               $55, $56, $57, $58, $59, $5A,
  97.               $60, $61, $62, $63, $64, $65, $66, $67, $68, $69,
  98.               $6A, $6B, $6C, $6D, $6E, $6F,
  99.               $70, $71, $72, $73, $74, $75, $76, $77, $78, $79, $7A, $7B,
  100.               $7C, $7D, $7E, $7F, $80, $81, $82, $83, $84, $85, $86, $87,
  101.               $90, $91);
  102.  
  103.  
  104. implementation
  105.  
  106. function MkHotKeyItem(const VirtKey: TVirtKey; Modifiers: THKModifiers): THotKeyItem;
  107. begin
  108.   Result.VirtKey := VirtKey;
  109.   Result.Modifiers := Modifiers;
  110. end;
  111.  
  112. { TSysHotKey }
  113.  
  114. constructor TSysHotKey.Create(AOwner : TComponent);
  115. begin
  116.   inherited Create(AOwner);
  117.   FList := TList.Create;
  118. end;
  119.  
  120. destructor TSysHotKey.Destroy;
  121. begin
  122.   Clear;
  123.   FList.Free;
  124.   inherited Destroy;
  125. end;
  126.  
  127. procedure TSysHotKey.Loaded;
  128. begin
  129.   inherited Loaded;
  130.   if Active then RegisterHotKeys;
  131. end;
  132.  
  133. procedure TSysHotKey.SetActive(Value : Boolean);
  134. begin
  135.   if FActive<>Value then
  136.    begin
  137.      FActive := Value;
  138.      if Active then RegisterHotKeys else UnregisterHotKeys;
  139.    end;
  140. end;
  141.  
  142. procedure TSysHotKey.wmHotKey(var Msg: TWMHotKey);
  143. begin
  144.   if Assigned(FOnHotKey) then FOnHotKey(Self, Msg.idHotKey);
  145. end;
  146.  
  147. function TSysHotKey.ModifiersToFlag(Modifiers : THKModifiers): UInt;
  148. begin
  149.   Result := 0;
  150.   if hkShift in Modifiers then Result := Result or MOD_SHIFT;
  151.   if hkCtrl  in Modifiers then Result := Result or MOD_CONTROL;
  152.   if hkAlt   in Modifiers then Result := Result or MOD_ALT;
  153.   if hkExt   in Modifiers then Result := Result or MOD_WIN;
  154. end;
  155.  
  156. procedure TSysHotKey.RegisterHotKeyNr(Index : Integer);
  157. begin
  158.   with PHotKeyItem(FList.Items[Index])^ do
  159.     Registered := WordBool(RegisterHotKey(Handle, Index, ModifiersToFlag(Modifiers), VirtKeys[VirtKey]));
  160. end;
  161.  
  162. procedure TSysHotKey.UnRegisterHotKeyNr(Index : Integer);
  163. begin
  164.   with PHotKeyItem(FList.Items[Index])^ do
  165.    if Registered then
  166.     begin
  167.       UnregisterHotKey(Handle, Index);
  168.       Registered := False;
  169.     end;
  170. end;
  171.  
  172. procedure TSysHotKey.RegisterHotKeys;
  173. var
  174.   I : integer;
  175. begin
  176.   for I:=0 to FList.Count-1 do
  177.    RegisterHotKeyNr(I);
  178. end;
  179.  
  180. procedure TSysHotKey.UnregisterHotKeys;
  181. var
  182.   I : integer;
  183. begin
  184.   for I:=0 to FList.Count-1 do
  185.    UnregisterHotKeyNr(I);
  186. end;
  187.  
  188. procedure TSysHotKey.wmDestroy(Var Msg : TWMDestroy);
  189. begin
  190.   Active := False;
  191.   inherited;
  192. end;
  193.  
  194. function TSysHotKey.Add(Item: THotKeyItem): integer;
  195. begin
  196.   Result := AddHotKey(Item.VirtKey, Item.Modifiers);
  197. end;
  198.  
  199. function TSysHotKey.AddHotKey(VirtKey: TVirtKey; Modifiers: THKModifiers): integer;
  200. var
  201.   p : PHotKeyItem;
  202. begin
  203.   p := PHotKeyItem(AllocMem(sizeof(THotKeyItem)));
  204.   p.VirtKey := VirtKey;
  205.   p.Modifiers := Modifiers;
  206.   Result := FList.Add(p);
  207.   if Active then RegisterHotKeyNr(Result);
  208. end;
  209.  
  210. procedure TSysHotKey.Clear;
  211. var
  212.   I : integer;
  213. begin
  214.   if Active then UnregisterHotKeys;
  215.   for I:=0 to FList.Count-1 do
  216.    FreeMem(FList.Items[I]);
  217.   FList.Clear;
  218. end;
  219.  
  220. procedure TSysHotKey.Delete(Index : Integer);
  221. begin
  222.   if Active then UnregisterHotKeyNr(Index);
  223.   FreeMem(FList.Items[Index]);
  224.   FList.Delete(Index);
  225. end;
  226.  
  227. function TSysHotKey.Get(Index: Integer): THotKeyItem;
  228. begin
  229.   Result := THotKeyItem(FList.Items[Index]^);
  230. end;
  231.  
  232. procedure TSysHotKey.Put(Index: Integer; Item: THotKeyItem);
  233. begin
  234.   if Active then UnregisterHotKeyNr(Index);
  235.   with THotKeyItem(FList.Items[Index]^) do
  236.    begin
  237.      VirtKey := Item.VirtKey;
  238.      Modifiers := Item.Modifiers;
  239.    end;
  240.   if Active then RegisterHotKeyNr(Index);
  241. end;
  242.  
  243. function TSysHotKey.GetCount: integer;
  244. begin
  245.   Result := FList.Count;
  246. end;
  247.  
  248. end.
  249.